Python-like generators in Scheme
;;;Python-like generators in Scheme ;;; ;;;Michele Simionato (michele.simionato@gmail.com) May 2005 ;;;Adapted from http://c2.com/cgi/wiki?SchemeCoroutineExample (define-macro (store/cc! name . body) (let ((k (gensym))) `(call-with-current-continuation (lambda (,k) (set! ,name ,k) ,@body)))) ; to spare parenthesis, real schemers will hate this one ;) (define-macro (let/ name value . args) `(match-let ((,name ,value)) ,@args)) ;; the core implementation (define (generator routine) (let/ (current status exit next) (list routine 'suspended #f #f) (match-lambda* (() (if (eq? status 'dead) (error 'dead-generator) (let/ continuation-and-value (store/cc! exit (let/ yield (lambda (value) (store/cc! next (exit (cons next value)))) (current yield) ; exits from here, ;; except after the last yield (set! status 'dead) (error 'dead-generator))) (if (pair? continuation-and-value) (begin (set! current (car continuation-and-value)) (cdr continuation-and-value)) continuation-and-value)))) (('status?) status) (('dead?) (eq? status 'dead)) (('alive?) (not (eq? status 'dead))) (('kill!) (set! status 'dead))))) ;; an example (define test (generator (lambda (yield) (yield "HELLO!") (yield "WORLD!")))) (test 'status?) ; suspended (test 'dead?) ; #f (test 'alive?) ; #t (test) ; "HELLO!" (test) ; "WORLD!" (test) ; Error: dead-generator (test 'status?) ; dead (test 'dead?) ; #t ;; another example: (define (list->iterator list) (generator (lambda (yield) (for-each yield list)))) (define (iterator-empty? iterator) (iterator 'dead?)) (define my-iterator (list->iterator (list 1 2 3))) (my-iterator) ; 1 (my-iterator) ; 2 (my-iterator) ; 3 (iterator-empty? my-iterator) ; #f
This required me to install the low-level-macros egg. And when I pasted the generator routine I got
---> (('kill!) (set! status 'dead))))) Error: illegal non-atomic object: () inside expression `(match-lambda* ...)' Call history: <eval> (##sys#apply ##sys#values args315) <eval> (apply297 (lambda298 (_253 name value args) (begin254 (quasiquote (match-let (((unquote name) (unquo...... <eval> (##sys#cons (##core#quote match-let) (##sys#cons (##sys#list (##sys#list name value)) args)) <eval> (##sys#cons (##sys#list (##sys#list name value)) args) <eval> (##sys#list (##sys#list name value)) <eval> (##sys#list name value) <syntax> [generator] (##core#begin (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (m...... <syntax> [generator] (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (match-lambda* (()... <syntax> [generator] (((current status exit next) (list routine (quote suspended) #f #f))) <syntax> [generator] ((current status exit next) (list routine (quote suspended) #f #f)) <syntax> [generator] (current status exit next) <syntax> [generator] (list routine (quote suspended) #f #f) <syntax> [generator] (quote suspended) <syntax> [generator] (##core#quote suspended) <syntax> [generator] (match-lambda* (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-a...... <syntax> [generator] (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-and-value (store...... <--